perm filename PGFAI.FAI[S,HE] blob
sn#577006 filedate 1982-05-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00022 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE PGFAI
C00005 00003 T PPHYSS PDDINI
C00008 00004 X1 XRMSK XLMSK PBSK BITUP PMIDI FBITUP
C00010 00005 RECTUP HORR NOTER LMDLR FINER LUPR
C00012 00006 HORUP NOTE LMDL FINE
C00014 00007 VERUP VLP
C00015 00008 DELT OBLUP DYGR DYPDXL SGLP DXGR DYPDXG SIGLP1
C00017 00009 FATUP FDYGR DYPFXL FSGLP FDXGR DYPFXG FSIGL1
C00019 00010 XL XH XSC YL YH YSC PSCREE PSCREM
C00021 00011 PLITEN PDRKEN PINVEN
C00022 00012 PDOT BFN
C00024 00013 PLINE PLS
C00026 00014 PRECTA
C00028 00015 PELLIP XC ELOOP SQRT SQ1 SQ2
C00032 00016 PPOLYG LFL
C00034 00017 POLYUP ILOP JLOP NOXCH NEWPNT HILP HINS TRYLOW LILP LINS DRAWG SCNRE SCNR DRAWM FLOP BLAR DRAWZ NEXL LPO SLOOP NELP FLOOP PFND FILIN
C00039 00018 TITLE FNTFAI
C00040 00019 L3X2 GT1 YLOOP FWL STL RTL
C00044 00020 L6X4 GT3 YLOOP3 FWL3 STL3 RTL3
C00048 00021 L1X1 GT4 YLOOP4 FWL4 STL4
C00051 00022 L3Y4 GT2 YLOOP2 FWL2 STL2 RTL2
C00055 ENDMK
C⊗;
TITLE PGFAI
;MAKES LINES AND THINGS IN ONE BIT PICTURES
ENTRY PDDINI,PSCREE,PSCREM,PLINE,PDOT,PPOLYG,PRECTA,pellip
ENTRY PDRKEN,PLITEN,PINVEN
ENTRY PBSK,PMIDI
ENTRY PPHYSS,FBITUP
PXLO: 0
PYLO: 0
PXHI: 0
PYHI: 0
PPIC: 0
PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BMAX←←12
BPTAB←13
LINTAB←←14
PIC←7
P←17
NWDS: 0 ;number of words in scanline, including border
XLOO:0 ;X offset
XLOL:0 ;left limit
XHIL:0 ;right limit
YLOO:0 ;Y offset
YLOL:0 ;top limit
YHIL:0 ;bottom limit
NLINA:0 ;virtual buffer height for SCREEN calculation
NBITA:0 ;virtual width
THK:0 ;line and dot thickness
THA:0 ;line and dot thickness (left or top side)
THB:0 ;line and dot thickness (right and bottom side)
TADJ:0 ;length adjustment for thick lines
RETAD: 0
ACS: BLOCK 20
DEFINE SAVAC(N)
< IFGE N-12,{MOVEM 12,ACS+12}
IFGE N-16,{MOVEM 16,ACS+16}
IFGE N-17,{MOVEM 17,ACS+17} >
DEFINE RESAC(N)
< IFGE N-12,{MOVE 12,ACS+12}
IFGE N-16,{MOVE 16,ACS+16}
IFGE N-17,{MOVE 17,ACS+17} >
define fix(x)<kifix x,x>
DEFINE FLOAT(N) <FLTR N,N>
;T PPHYSS PDDINI
T←0 ↔ YLO←15 ↔ XLO←14 ↔ YHI←3 ↔ XHI←4 ↔ PIC←7
PPHYSS: POP P,RETAD ;return position and limits of drawing buffer
POP P,XHI
MOVE T,PXHI
MOVEM T,(XHI)
POP P,YHI
MOVE T,PYHI
MOVEM T,(YHI)
POP P,XLO
MOVE T,PXLO
MOVEM T,(XLO)
POP P,YLO
MOVE T,PYLO
MOVEM T,(YLO)
POP P,PIC
MOVE T,PPIC
MOVEM T,(PIC)
JRST @RETAD
PDDINI: POP P,RETAD ;establish a buffer for drawing
POP P,XHI
POP P,YHI
POP P,XLO
POP P,YLO
POP P,PIC
MOVEM PIC,PPIC
CAMLE XLO,XHI
EXCH XLO,XHI
CAMLE YLO,YHI
EXCH YLO,YHI
MOVEM XLO,PXLO
MOVEM XHI,PXHI
MOVEM YLO,PYLO
MOVEM YHI,PYHI
MOVE T,YHI ;height, for SCREEN calculation
SUB T,YLO
ADDI T,1
MOVEM T,NLINA
MOVE T,XHI ;width, for SCREEN calculation
SUB T,XLO
ADDI T,1
MOVEM T,NBITA
MOVEM XLO,XLOO ;X offset for deposits
MOVEM YLO,YLOO ;Y offset
CAIGE XLO,0
MOVEI XLO,0
MOVEM XLO,XLOL ;physical left limit
CAIGE YLO,0
MOVEI YLO,0
MOVEM YLO,YLOL ;physical top limit
MOVE T,LNBY(PIC)
SUBI T,1
CAMLE XHI,T
MOVE XHI,T
MOVEM XHI,XHIL ;physical right limit
MOVE T,PCLN(PIC)
SUBI T,1
CAMLE YHI,T
MOVE YHI,T
MOVEM YHI,YHIL ;pyhsical bottom limit
MOVE YLO,LNWD(PIC)
MOVEM YLO,NWDS ;save scanlinesize
IMUL YLO,YLOO
MOVE T,LINTAB(PIC)
ADD T,YLO ;Y offset can be done implicitly
HRRM T,PMIDI
MOVN YLO,YLOO
ADDM YLO,YLOL
ADDM YLO,YHIL
JRST @RETAD
;X1 XRMSK XLMSK PBSK BITUP PMIDI FBITUP
X1←1 ↔ XA←X1+1 ↔ X2←3 ↔ XB←X2+1 ↔ Y1←5 ↔ Y2←11
XRMSK: FOR I←0,43,1 { (-1)⊗(-I)
}
XLMSK: FOR I←0,43,1 { ¬(377777777777⊗(-I))
}
PBSK: FOR I←0,43,1 { 400000000000 ⊗ (-I)
}
BITUP: 0 ;ROUTINE FOR PLACING A BIT AT (X1,Y1)
CAML Y1,YLOL
CAMLE Y1,YHIL
JRST @BITUP
ADD X1,XLOO
CAML X1,XLOL
CAMLE X1,XHIL
JRST @BITUP
IDIVI X1,44
MOVE 10,PBSK(XA)
IMUL Y1,NWDS
ADD X1,Y1
PMIDI: ORM 10,(X1)
JRST @BITUP
FBITUP: POP P,RETAD
POP P,Y1 ;A FONT'S BIT AT (X1,Y1)
POP P,X1
CAML X1,XLOL
CAMLE X1,XHIL
JRST @RETAD
SUB Y1,YLOO
CAML Y1,YLOL
CAMLE Y1,YHIL
JRST @RETAD
IDIVI X1,44
MOVE 10,PBSK(XA)
IMUL Y1,NWDS
ADD X1,Y1
XCT PMIDI
JRST @RETAD
;RECTUP HORR NOTER LMDLR FINER LUPR
RECTUP: 0 ;ROUTINE FOR PLACING A BIT AT (X1,Y1)
CAMLE Y1,Y2
EXCH Y1,Y2
CAMGE Y1,YLOL
MOVE Y1,YLOL
CAMLE Y2,YHIL
MOVE Y2,YHIL
CAMLE Y1,Y2
JRST @RECTUP
ADD X1,XLOO
ADD X2,XLOO
CAMLE X1,X2
EXCH X1,X2
CAMGE X1,XLOL
MOVE X1,XLOL
CAMLE X2,XHIL
MOVE X2,XHIL
CAMLE X1,X2
JRST @RECTUP
IDIVI X1,44
IDIVI X2,44
MOVE 0,X2
SUB 0,X1
SUB Y2,Y1
IMUL Y1,NWDS
ADD Y1,X1
HORR: MOVE X2,0
MOVE X1,Y1
MOVE 10,XRMSK(XA)
JUMPG X2,NOTER
AND 10,XLMSK(XB)
XCT PMIDI
JRST LUPR
NOTER: XCT PMIDI
SETO 10,
LMDLR: AOS X1
SOJLE X2,FINER
XCT PMIDI
AOJA X1,LMDLR+1
FINER: MOVE 10,XLMSK(XB)
XCT PMIDI
LUPR: ADD Y1,NWDS
SOJGE Y2,HORR
JRST @RECTUP
;HORUP NOTE LMDL FINE
; HORUP takes X1,X2,Y2 as inputs, clobbers 0,X1+1,X2+1,10
HORUP: 0 ;ROUTINE FOR PUTTING UP A HORIZONTAL
CAML Y1,YLOL ;LINE AT Y1, BETWEEN X1 AND X2
CAMLE Y1,YHIL
JRST @HORUP
ADD X1,XLOO
ADD X2,XLOO
CAMLE X1,X2
EXCH X1,X2
CAML X2,XLOL
CAMLE X1,XHIL
JRST @HORUP
CAMGE X1,XLOL
MOVE X1,XLOL
CAMLE X2,XHIL
MOVE X2,XHIL
IDIVI X1,44
IDIVI X2,44
MOVE 10,XRMSK(XA)
SUB X2,X1
MOVE 0,Y1
IMUL 0,NWDS
ADD X1,0
JUMPG X2,NOTE
AND 10,XLMSK(XB)
XCT PMIDI
JRST @HORUP
NOTE: XCT PMIDI
SETO 10,
LMDL: AOS X1
SOJLE X2,FINE
XCT PMIDI
AOJA X1,LMDL+1
FINE: MOVE 10,XLMSK(XB)
XCT PMIDI
JRST @HORUP
;VERUP VLP
VERUP: 0 ;ROUTINE FOR MAKING A VERTICAL
ADD X1,XLOO
CAML X1,XLOL ;LINE AT X1 BETWEEN Y1 AND Y2
CAMLE X1,XHIL
JRST @VERUP
CAML Y1,Y2
EXCH Y1,Y2
CAML Y2,YLOL
CAMLE Y1,YHIL
JRST @VERUP
CAMGE Y1,YLOL
MOVE Y1,YLOL
CAMLE Y2,YHIL
MOVE Y2,YHIL
IDIVI X1,44
MOVE 10,PBSK(XA)
MOVE 0,Y1
IMUL 0,NWDS
ADD X1,0
VLP: XCT PMIDI
CAML Y1,Y2
JRST @VERUP
ADD X1,NWDS
AOJA Y1,VLP
;DELT OBLUP DYGR DYPDXL SGLP DXGR DYPDXG SIGLP1
DELT←6 ↔ DIND←12 ↔ XLO←14 ↔ YLO←15
OBLUP: 0 ;ROUTINE FOR DRAWING AN OBLIQUE
SUB X2,X1 ;LINE FROM (X1,Y1) TO (X2,Y2)
SUB Y2,Y1
MOVM XLO,X2
MOVM YLO,Y2
MOVEI DELT,400000
CAMLE XLO,YLO
JRST DXGR
DYGR: JUMPGE X2,DYPDXL
MOVN X2,X2
MOVN Y2,Y2
SUB X1,X2
SUB Y1,Y2
DYPDXL: HRL DELT,Y2
AOS DIND,X2
IDIV DELT,X2
HRLZ YLO,Y1
MOVE XLO,X1
SGLP: MOVE Y2,DELT
ADDB YLO,Y2
HLRE Y2,Y2
JSR VERUP
SOJLE DIND,@OBLUP
AOS X1,XLO
HLRE Y1,YLO
JRST SGLP
DXGR: JUMPGE Y2,DYPDXG
MOVN X2,X2
MOVN Y2,Y2
SUB X1,X2
SUB Y1,Y2
DYPDXG: HRL DELT,X2
AOS DIND,Y2
IDIV DELT,Y2
HRLZ XLO,X1
MOVE YLO,Y1
SIGLP1: MOVE X2,DELT
ADDB X2,XLO
HLRE X2,X2
JSR HORUP
SOJLE DIND,@OBLUP
AOS Y1,YLO
HLRE X1,XLO
JRST SIGLP1
;FATUP FDYGR DYPFXL FSGLP FDXGR DYPFXG FSIGL1
FATUP: 0 ;ROUTINE FOR DRAWING AN OBLIQUE FAT
SUB X2,X1 ;LINE FROM (X1,Y1) TO (X2,Y2)
SUB Y2,Y1
MOVM XLO,X2
MOVM YLO,Y2
MOVEI DELT,400000
CAMLE XLO,YLO
JRST FDXGR
FDYGR: JUMPGE X2,DYPFXL
MOVN X2,X2
MOVN Y2,Y2
SUB X1,X2
SUB Y1,Y2
DYPFXL: HLRE 0,Y2
ASH 0,-21
ORI 0,1
MOVEM 0,TADJ
ADD Y2,TADJ
HRL DELT,Y2
AOS DIND,X2
IDIV DELT,X2
HRLZ YLO,Y1
MOVE XLO,X1
FSGLP: MOVE Y2,DELT
ADDB YLO,Y2
HLRE Y2,Y2
MOVE X2,X1
ADD X1,THA
ADD X2,THB
SUB Y2,TADJ
JSR RECTUP
SOJLE DIND,@FATUP
AOS X1,XLO
HLRE Y1,YLO
JRST FSGLP
FDXGR: JUMPGE Y2,DYPFXG
MOVN X2,X2
MOVN Y2,Y2
SUB X1,X2
SUB Y1,Y2
DYPFXG: HLRE 0,X2
ASH 0,-21
ORI 0,1
MOVEM 0,TADJ
ADD X2,TADJ
HRL DELT,X2
AOS DIND,Y2
IDIV DELT,Y2
HRLZ XLO,X1
MOVE YLO,Y1
FSIGL1: MOVE X2,DELT
ADDB X2,XLO
HLRE X2,X2
MOVE Y2,Y1
ADD Y1,THA
ADD Y2,THB
SUB X2,TADJ
JSR RECTUP
SOJLE DIND,@FATUP
AOS Y1,YLO
HLRE X1,XLO
JRST FSIGL1
;XL XH XSC YL YH YSC PSCREE PSCREM
XL: 0.0
XH: 1.0
XSC: 1476.0
YL: 0.0
YH: 1.0
YSC: 2048.0
PSCREE: SAVAC(3) ;SET UP SCREEN DIMENSIONS
POP P,RETAD ;SCREEN(XL,YL,XH,YH)
POP P,YL ;DEFAULT XL=0.0 YH=1.0
POP P,XH ; YL=0.0 YH=1.0
POP P,YH
POP P,XL
MOVE 1,XH
FSBR 1,XL
FLTR 3,NBITA
FMPR 3,[0.9999]
FDVR 3,1
MOVEM 3,XSC
MOVE 1,YH
FSBR 1,YL
FLTR 3,NLINA
FMPR 3,[0.9999]
FDVR 3,1
MOVEM 3,YSC
RESAC(3)
JRST @RETAD
PSCREM: POP P,RETAD
POP P,1
MOVE 2,YL
MOVEM 2,(1)
POP P,1
MOVE 2,XH
MOVEM 2,(1)
POP P,1
MOVE 2,YH
MOVEM 2,(1)
POP P,1
MOVE 2,XL
MOVEM 2,(1)
JRST @RETAD
;PLITEN PDRKEN PINVEN
PLITEN: MOVE 1,[ ORM 10,(X1)] ;OUTPUTS TO APPEAR BRIGHT
HLLM 1,PMIDI ;(ACTUALLY DARK TONER ON XGP)
POPJ P,
PDRKEN: MOVE 1,[ ANDCAM 10,(X1)] ;OUTPUTS DARK
HLLM 1,PMIDI ;(WHITE, ACTUALLY, PAPER SHOWS THRU)
POPJ P,
PINVEN: MOVE 1,[ XORM 10,(X1)] ;OUTPUTS TO NEGATE PREVIUS DISPLAY
HLLM 1,PMIDI
POPJ P,
;PDOT BFN
PDOT: SAVAC(10)
POP P,RETAD
POP P,THK
MOVE 0,THK
ASH 0,-1
MOVEM 0,THA
SUB 0,THK
ADDI 0,1
MOVEM 0,THB
POP P,Y1
POP P,X1
MOVE XA,XL ;SCREEN bounds test for X
MOVE XB,XH
CAMLE XA,XB
EXCH XA,XB
CAMG X1,XB
CAMGE X1,XA
JRST @RETAD
MOVE XA,YL ;SCREEN bounds test for Y
MOVE XB,YH
CAMLE XA,XB
EXCH XA,XB
CAMG Y1,XB
CAMGE Y1,XA
JRST @RETAD
FSBR Y1,YL
FMPR Y1,YSC
FIX Y1
FSBR X1,XL
FMPR X1,XSC
FIX X1
SKIPE THK
JRST [MOVE Y2,Y1 ↔ ADD Y1,THA ↔ ADD Y2,THB
MOVE X2,X1 ↔ ADD X1,THA ↔ ADD X2,THB
JSR RECTUP ↔ JRST BFN]
JSR BITUP
BFN: RESAC(10)
JRST @RETAD
;PLINE PLS
PLINE: SAVAC(16) ;DRAW A LINE FORM (X1,Y1) TO (X2,Y2)
POP P,RETAD
POP P,THK
MOVE 0,THK
ASH 0,-1
MOVEM 0,THA
SUB 0,THK
ADDI 0,1
MOVEM 0,THB
POP P,Y2
POP P,X2 ;LINE(X1,Y1,X2,Y2)
POP P,Y1
POP P,X1
MOVE XA,XL ;SCREEN bounds test for X
MOVE XB,XH
CAMLE XA,XB
EXCH XA,XB
MOVE 0,X1
MOVE 6,X2
CAMLE 0,6
EXCH 0,6
CAMG 0,XB
CAMGE 6,XA
JRST @RETAD
MOVE XA,YL ;SCREEN bounds test for Y
MOVE XB,YH
CAMLE XA,XB
EXCH XA,XB
MOVE 0,Y1
MOVE 6,Y2
CAMLE 0,6
EXCH 0,6
CAMG 0,XB
CAMGE 6,XA
JRST @RETAD
FSBR Y2,YL
FMPR Y2,YSC
FIX Y2
FSBR X2,XL
FMPR X2,XSC
FIX X2
FSBR Y1,YL
FMPR Y1,YSC
FIX Y1
FSBR X1,XL
FMPR X1,XSC
FIX X1
SKIPE THK
JRST [JSR FATUP ↔ JRST PLS]
JSR OBLUP
PLS: RESAC(16)
JRST @RETAD
;PRECTA
PRECTA: SAVAC(15) ;DRAW A RECTANGLE IN (X1,Y1) TO (X2,Y2)
POP P,RETAD
POP P,Y2
POP P,X2 ;PRECTA(X1,Y1,X2,Y2)
POP P,Y1
POP P,X1
MOVE XA,XL ;SCREEN bounds test for X
MOVE XB,XH
CAMLE XA,XB
EXCH XA,XB
MOVE 0,X1
MOVE 6,X2
CAMLE 0,6
EXCH 0,6
CAMG 0,XB
CAMGE 6,XA
JRST @RETAD
MOVE XA,YL ;SCREEN bounds test for Y
MOVE XB,YH
CAMLE XA,XB
EXCH XA,XB
MOVE 0,Y1
MOVE 6,Y2
CAMLE 0,6
EXCH 0,6
CAMG 0,XB
CAMGE 6,XA
JRST @RETAD
FSBR Y2,YL
FMPR Y2,YSC
FIX Y2
FSBR X2,XL
FMPR X2,XSC
FIX X2
FSBR Y1,YL
FMPR Y1,YSC
FIX Y1
FSBR X1,XL
FMPR X1,XSC
FIX X1
JSR RECTUP
RESAC(15)
JRST @RETAD
;PELLIP XC ELOOP SQRT SQ1 SQ2
PELLIP: ;FILL IN THE ELLIPSE BOUNDED
POP P,RETAD ;BY X1 AND X2 AND Y1 AND Y2
POP P,Y2 ;AND ORIENTED PARALELL TO THE
POP P,X2
POP P,Y1
POP P,X1
MOVE XA,XL ;SCREEN bounds test for X
MOVE XB,XH
CAMLE XA,XB
EXCH XA,XB
MOVE 0,X1
MOVE 6,X2
CAMLE 0,6
EXCH 0,6
CAMG 0,XB
CAMGE 6,XA
JRST @RETAD
MOVE XA,YL ;SCREEN bounds test for Y
MOVE XB,YH
CAMLE XA,XB
EXCH XA,XB
MOVE 0,Y1
MOVE 6,Y2
CAMLE 0,6
EXCH 0,6
CAMG 0,XB
CAMGE 6,XA
JRST @RETAD
FSBR Y2,YL ;MAIN AXES
FMPR Y2,YSC ;ELLIPS(X1,Y1,X2,Y2);
FIX Y2,
FSBR X2,XL
FMPR X2,XSC
FIX X2,
FSBR Y1,YL
FMPR Y1,YSC
FIX Y1,
FSBR X1,XL
FMPR X1,XSC
FIX X1,
XC←←6 ↔ B←←X←←2 ↔ C←←XX←←B+1 ↔ Y←←7 ↔ H←←14 ↔ W←←15
CAMLE Y1,Y2
EXCH Y1,Y2
MOVE H,Y2
ADDI H,1
SUB H,Y1 ; H ← (YHi + 1) - YLo (the height of the ellipse)
MOVE Y,H
SUBI Y,1
FLOAT (Y)
FLOAT (H)
FMPR H,H
CAMLE X1,X2
EXCH X1,X2
MOVE W,X2
SUB W,X1
FLOAT (W)
FMPR W,W
MOVE XC,X1
ADD XC,X2
; here, registers are:
; XC is X1 + X2, or center point * 2
; Y1 is Ylo of ellipse (fixed)
; Y2 is YHi of ellipse (fixed)
; Y is current y 'slice' of ellipse, normalized to it's center (floating)
; H is height ↑ 2 of ellipse (floating)
; W is width ↑ 2 of ellipse (floating)
;
; This loop calulates an ellipse centered at (Xc,Yc) as
; Yc ← +or- W * SQRT(1-((Y-Yc)/H)↑2). In actuality, the formula used is
; Yc ← +or- SQRT((W↑2*(H↑2-Y↑2))/H↑2)
; The loop iterates on succesive values of Y, which starts at the top and works down
;
ELOOP: MOVE X,H ; X ← H↑2
MOVE XB,Y
FMPR XB,XB
FSBR X,XB ; X ← (H↑2 - Y↑2)
FMPR X,W ; X ← W↑2 * (H↑2 - Y↑2)
FDVR X,H ; X ← (W↑2 * (H↑2 - Y↑2))/H↑2
SQRT: ASHC B,-33 ; B = X ← SQRT(W↑2 * (H↑2 - Y↑2))/H↑2)
SUBI B,201
ROT B,-1
PUSH P,B
LSH B,-43
ASH C,-10
FSC C,177(B)
MOVEM C,1(P) ;FORTRAN SQRT ROUTINE
FMP C,SQ1(B)
FAD C,SQ2(B)
MOVE B,1(P)
FDV B,C
FAD C,B
FSC C,-1
MOVE B,1(P)
FDV B,C
FADR B,C
POP P,C
FSC B,(C)
; (end of sqrt)
FIX X,
MOVE X1,XC
MOVE X2,XC
SUB X1,X ; X1 ← Xc - X
ADD X2,X ; X2 ← Xc + X
ADDI X2,1
ASH X2,-1 ; Xc was '2 times' the center, fix that now
ASH X1,-1
JSR HORUP ; may not clobber Y,Y1,Y2,H,W,XC
FSBR Y,[2.0]
CAMGE Y1,Y2
AOJA Y1,ELOOP
JRST @RETAD
SQ1: 0.8125 ;CONSTANTS FOR SQRT ROUTINE
0.578125
SQ2: 0.302734
0.421875
;PPOLYG LFL
X1←1 ↔ XA←2 ↔ JJ←2
X2←3 ↔ XB←4 ↔ T←4
Y1←5
Y2←←6
I←←7
II←←12
N←13
J←←14
TT←←15
TTT←←16
P←17
PPOLYG: movem 12,ac12# ;FILL IN AN N SIDED POLYGON
movem 16,ac16#
POP P,RETAD ; POLYGO(N,X,Y)
POP P,Y2 ; X AND Y ARE EACH CONTIGUOUS ARRAYS
POP P,X2
POP P,N
HRRZ T,N
MOVE N,T
LFL: MOVE TT,(X2)
FSBR TT,XL
FMPR TT,XSC
FIX TT
MOVEM TT,PX(T)
MOVE TT,(Y2)
FSBR TT,YL
FMPR TT,YSC
FIX TT
MOVEM TT,PY(T)
ADDI X2,1
ADDI Y2,1
SOJG T,LFL
JSR POLYUP
move 12,ac12
move 16,ac16
JRST @RETAD
;POLYUP ILOP JLOP NOXCH NEWPNT HILP HINS TRYLOW LILP LINS DRAWG SCNRE SCNR DRAWM FLOP BLAR DRAWZ NEXL LPO SLOOP NELP FLOOP PFND FILIN
PX: 0
BLOCK 1500
PY: 0
BLOCK 1500
RNK: 0
BLOCK 1500
DXS: 0
BLOCK 1500
NS: 0
BLOCK 1500
LOUT: BLOCK 1500
LXS: 377777777777
BLOCK 1500
SAVN: 0
POLYUP: 0 ;ROUTINE TO FILL IN A POLYGON
MOVEM N,SAVN
MOVEI I,1
MOVEM I,RNK+1 ;PHASE 1, GENERATE AN
ILOP: AOS II,I ;INVERSE RANKING
MOVE T,PY(I) ;KEYED ON Y VALUES
MOVEI J,1
JLOP: MOVE JJ,RNK(J)
CAML T,PY(JJ)
JRST NOXCH
EXCH II,RNK(J)
MOVE T,PY(II)
NOXCH: CAIGE J,-1(I)
AOJA J,JLOP
MOVEM II,RNK(I)
CAMGE I,N
JRST ILOP
MOVE T,PX+1
MOVEM T,PX+1(N)
MOVE T,PY+1
MOVEM T,PY+1(N)
MOVE T,PX(N)
MOVEM T,PX
MOVE T,PY(N)
MOVEM T,PY
MOVEI I,1
MOVEI J,0
MOVE II,RNK(I)
MOVE Y1,PY(II)
NEWPNT: HRLZ X1,PX(II)
MOVE T,PY-1(II)
SUB T,Y1
JUMPLE T,TRYLOW+1 ;FORGET IT IF THIS EDGE POINTS
SKIPG JJ,J ;UPWARDS
JRST HINS
HILP: CAMG X1,LXS(JJ)
JRST HINS
MOVE TT,LXS(JJ)
MOVEM TT,LXS+1(JJ)
MOVE TT,DXS(JJ)
MOVEM TT,DXS+1(JJ)
MOVE TT,NS(JJ)
MOVEM TT,NS+1(JJ)
SOJG JJ,HILP
HINS: MOVEM T,NS+1(JJ) ;INSERT LINE SEGS
MOVEM X1,LXS+1(JJ) ;COMING INTO THE SCANLINE
HLRE X1,X1
SUB X1,PX-1(II)
HRLZ X2,X1
HRRI X1,400000
ADD X2,X1
IDIVI X2,1(T)
MOVNM X2,DXS+1(JJ)
ADDI J,1
TRYLOW: HRLZ X1,PX(II)
MOVE T,PY+1(II)
SUB T,Y1
JUMPL T,DRAWG ;IF THIS EDGE POINTS
SKIPG JJ,J ;UPWARDS, TIME TO DRAW
JRST LINS
LILP: CAMG X1,LXS(JJ)
JRST LINS
MOVE TT,LXS(JJ)
MOVEM TT,LXS+1(JJ)
MOVE TT,DXS(JJ)
MOVEM TT,DXS+1(JJ)
MOVE TT,NS(JJ)
MOVEM TT,NS+1(JJ)
SOJG JJ,LILP
LINS: MOVEM T,NS+1(JJ)
MOVEM X1,LXS+1(JJ)
HLRE X1,X1
SUB X1,PX+1(II)
HRLZ X2,X1
HRRI X1,400000
ADD X2,X1
IDIVI X2,1(T)
MOVNM X2,DXS+1(JJ)
ADDI J,1
DRAWG: CAML I,SAVN
JRST DRAWM
ADDI I,1
SCNRE: MOVE II,RNK(I)
SCNR: CAMN Y1,PY(II)
JRST NEWPNT
DRAWM: MOVE JJ,J ;UPDATE EACH EDGE
SETZB T,II ;AND THEN
FLOP: MOVE X1,LXS(JJ) ;MAKE UP DRAWING LIST
MOVE X2,DXS(JJ)
ADDB X2,LXS(JJ)
JSR FILIN
SOSL NS(JJ)
TRCE T,1
JUMPE T,BLAR
MOVE X2,LXS-1(JJ)
JSR FILIN
BLAR: SOJG JJ,FLOP
DRAWZ: HRRE X1,LOUT(II) ;DRAW THIS SET
HLRE X2,LOUT(II)
JSR HORUP
SOJG II,DRAWZ
NEXL: MOVN JJ,J ;REMOVE EXPIRED SEGMNTS
HRLZ JJ,JJ ;AND MAKE POINTS SORTED
MOVEI J,0 ;AGAIN, IN PREPARATION
LPO: SKIPL NS+1(JJ) ;FOR NEXT SCANLINE
AOJA J,NELP
SLOOP: AOBJN JJ,LPO
JUMPLE J,@POLYUP
AOJA Y1,SCNRE
NELP: MOVE T,LXS+1(JJ)
MOVE TT,DXS+1(JJ)
MOVE TTT,NS+1(JJ)
MOVEI II,-1(J)
FLOOP: CAMG T,LXS(II)
JRST PFND
MOVE X1,LXS(II)
MOVEM X1,LXS+1(II)
MOVE X1,DXS(II)
MOVEM X1,DXS+1(II)
MOVE X1,NS(II)
MOVEM X1,NS+1(II)
SOJG II,FLOOP
PFND: MOVEM T,LXS+1(II)
MOVEM TT,DXS+1(II)
MOVEM TTT,NS+1(II)
AOBJN JJ,LPO
AOJA Y1,SCNRE
FILIN: 0 ;ADD A LINE SEGMENT
HLRM X1,LOUT+1(II)
HLLM X2,LOUT+1(II)
AOJA II,@FILIN
PRGEND
TITLE FNTFAI
ENTRY L3X2, L3Y4, L6X4, L1X1
PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BMAX←←12
BPTAB←←13
LINTAB←←14
T←0 ↔ XLO←1 ↔ XLR←2 ↔ XHI←3 ↔ XHR←4 ↔ PICPNT←5 ↔ BITPNT←6
TT←7 ↔ PIC←10 ↔ YLO←11 ↔ NFWD←12 ↔ RASW←13 ↔ YEX←14 ↔ PICPT2←CHAR←15
P←17
RETAD: 0
;L3X2 GT1 YLOOP FWL STL RTL
L3X2: POP P,RETAD ; L3X2(PIC,YLO,XLO,CHAR)
POP P,CHAR ;routine to assemble a 3 by 2 compressed character.
POP P,XLO
POP P,YLO
POP P,PIC
JUMPL XLO,@RETAD
MOVE RASW,(CHAR)
LSH RASW,-33 ;fetch raster width from font def
MOVEI XHI,-1(RASW) ;use it with XLO to get XHI
ADD XHI,XLO
HRRZ YEX,1(CHAR) ;get DATA ROW COUNT from def
MOVE T,YLO
ADDI T,1(YEX) ;bounds check for Y
ASH T,-1
SUB T,PCLN(PIC)
ASH T,1
CAILE T,0
SUB YEX,T
JUMPLE YEX,@RETAD
MOVEI BITPNT,1(CHAR) ;construct byte pointer
TLO BITPNT,100 ;for bit array
IDIVI XLO,3 ;get position of starting bit
IDIVI XHI,3 ;and finishing bit
CAML XHI,LNBY(PIC)
JRST @RETAD
SUB XHI,XLO ;calculate number of pic bytes-1
JUMPG XHI,GT1 ;and if exactly one byte,
SUB XHR,XLR ;calculate how many bits in it-1
GT1: ASH XLR,1 ;calculate jump offset for main loop
SUBI XHR,2 ;and for trailing last byte
MOVN XHR,XHR
ASH XHR,1
MOVE TT,BPTAB(PIC) ;set up skeleton byte pointer
ADD TT,XLO ;for X
MOVE PICPT2,(TT)
PUSH P,12
MOVNI YEX,(YEX) ;loop counter for Y, neg count in left *****
HRL YLO,YEX ; <TWICE> line number in right
YLOOP: MOVEI TT,(YLO) ;finish up byte pointer by inserting
ASH TT,-1 ;line address for current Y position
ADDI TT,LINTAB(PIC)
MOVE PICPNT,PICPT2
ADD PICPNT,(TT)
LDB TT,PICPNT ;pick up first affected picture byte
JUMPE XHI,RTL(XHR) ;if only one altogether, skip loop
MOVE NFWD,XHI ;if more than one, do first fractional
JRST STL(XLR) ;one
FWL: ILDB TT,PICPNT ;and then do all the others but the last
STL: ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
CAMLE TT,BMAX(PIC) ;check for byte overflow
MOVE TT,BMAX(PIC)
DPB TT,PICPNT ;return it
SOJG NFWD,FWL
ILDB TT,PICPNT ;the last affected byte
JRST RTL(XHR) ;see how much of it to do
RTL: ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
CAMLE TT,BMAX(PIC) ;bounds check
MOVE TT,BMAX(PIC)
DPB TT,PICPNT ;return it
MOVE T,BITPNT ;check if time to skip BP
LSH T,-36 ;in font definition
CAMGE T,RASW ;to next line
AND BITPNT,[7777777777]
AOBJN YLO,YLOOP ;check if all lines done
POP P,12
JRST @RETAD
;L6X4 GT3 YLOOP3 FWL3 STL3 RTL3
L6X4: POP P,RETAD ; L6X4(PIC,YLO,XLO,CHAR)
POP P,CHAR
POP P,XLO
POP P,YLO
POP P,PIC
JUMPL XLO,@RETAD
MOVE RASW,(CHAR)
LSH RASW,-33 ;fetch raster width from font def
MOVEI XHI,-1(RASW) ;use it with XLO to get XHI
ADD XHI,XLO
HRRZ YEX,1(CHAR) ;get DATA ROW COUNT from def
MOVE T,YLO
ADDI T,1(YEX) ;bounds check for Y
ASH T,-2
SUB T,PCLN(PIC)
ADDI T,1
ASH T,2
CAILE T,0
SUB YEX,T
JUMPLE YEX,@RETAD
MOVEI BITPNT,1(CHAR) ;construct byte pointer
TLO BITPNT,100 ;for bit array
IDIVI XLO,6 ;get position of starting bit
IDIVI XHI,6 ;and finishing bit
CAML XHI,LNBY(PIC)
JRST @RETAD
SUB XHI,XLO ;calculate number of pic bytes-1
JUMPG XHI,GT3 ;and if exactly one byte,
SUB XHR,XLR ;calculate how many bits in it-1
GT3: ASH XLR,1 ;calculate jump offset for main loop
SUBI XHR,5 ;and for trailing last byte
MOVN XHR,XHR
ASH XHR,1
MOVE TT,BPTAB(PIC) ;set up skeleton byte pointer
ADD TT,XLO ;for X
MOVE PICPT2,(TT)
PUSH P,12
MOVNI YEX,(YEX) ; loop counter for Y, neg count in left
HRL YLO,YEX ; <TWICE> line number in right
YLOOP3: MOVEI TT,(YLO) ;finish up byte pointer by inserting
ASH TT,-2 ;line address for current Y position
ADDI TT,LINTAB(PIC)
MOVE PICPNT,PICPT2
ADD PICPNT,(TT)
LDB TT,PICPNT ;pick up first affected picture byte
JUMPE XHI,RTL3(XHR) ;if only one altogether, skip loop
MOVE NFWD,XHI ;if more than one, do first fractional
JRST STL3(XLR) ;one
FWL3: ILDB TT,PICPNT ;and then do all the others but the last
STL3: ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
CAMLE TT,BMAX(PIC) ;check for byte overflow
MOVE TT,BMAX(PIC)
DPB TT,PICPNT ;return it
SOJG NFWD,FWL3
ILDB TT,PICPNT ;the last affected byte
JRST RTL3(XHR) ;see how much of it to do
RTL3: ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
CAMLE TT,BMAX(PIC) ;bounds check
MOVE TT,BMAX(PIC)
DPB TT,PICPNT ;return it
MOVE T,BITPNT ;check if time to skip BP
LSH T,-36 ;in font definition
CAMGE T,RASW ;to next line
AND BITPNT,[7777777777]
AOBJN YLO,YLOOP3 ;check if all lines done
POP P,12
JRST @RETAD
;L1X1 GT4 YLOOP4 FWL4 STL4
L1X1: POP P,RETAD ; L1X1(PIC,YLO,XLO,CHAR)
POP P,CHAR ;routine to assemble an uncompressed character.
POP P,XLO
POP P,YLO
POP P,PIC
JUMPL XLO,@RETAD
MOVE RASW,(CHAR)
LSH RASW,-33 ;fetch raster width from font def
MOVEI XHI,-1(RASW) ;use it with XLO to get XHI
ADD XHI,XLO
HRRZ YEX,1(CHAR) ;get DATA ROW COUNT from def
MOVE T,YLO
ADDI T,(YEX) ;bounds check for Y
SUB T,PCLN(PIC)
CAILE T,0
SUB YEX,T
JUMPLE YEX,@RETAD
MOVEI BITPNT,1(CHAR) ;construct byte pointer
TLO BITPNT,100 ;for bit array
CAML XHI,LNBY(PIC)
JRST @RETAD
SUB XHI,XLO ;calculate number of pic bytes-1
GT4: MOVE TT,BPTAB(PIC) ;set up skeleton byte pointer
ADD TT,XLO ;for X
MOVE PICPT2,(TT)
MOVNI YEX,(YEX) ;loop counter for Y, neg count in left
HRL YLO,YEX ;line number in right
YLOOP4: MOVEI TT,(YLO) ;finish up byte pointer for picture
ADDI TT,LINTAB(PIC) ;by inserting line address
MOVE PICPNT,PICPT2
ADD PICPNT,(TT)
LDB TT,PICPNT ;pick up first affected picture byte
SKIPA XHR,XHI ;and go into loop
FWL4: ILDB TT,PICPNT ;do all the bits
STL4: ILDB T,BITPNT
OR TT,T
DPB TT,PICPNT ;return it
SOJGE XHR,FWL4
MOVE T,BITPNT ;check if time to skip BP
LSH T,-36 ;in font definition
CAMGE T,RASW ;to next line
AND BITPNT,[7777777777]
AOBJN YLO,YLOOP4 ;check if all lines done
JRST @RETAD
;L3Y4 GT2 YLOOP2 FWL2 STL2 RTL2
L3Y4: POP P,RETAD ; L3Y4(PIC,YLO,XLO,CHAR)
POP P,CHAR ;for sideways full pages
POP P,XLO
POP P,YLO
POP P,PIC
JUMPL XLO,@RETAD
MOVE RASW,(CHAR)
LSH RASW,-33 ;fetch raster width from font def
MOVEI XHI,-1(RASW) ;use it with XLO to get XHI
ADD XHI,XLO
HRRZ YEX,1(CHAR) ;get DATA ROW COUNT from def
MOVE T,YLO
ADDI T,1(YEX) ;bounds check for Y
ASH T,-2
SUB T,LNBY(PIC)
ASH T,2
CAILE T,0
SUB YEX,T
JUMPLE YEX,@RETAD
MOVEI BITPNT,1(CHAR) ;construct byte pointer
TLO BITPNT,100 ;for bit array
IDIVI XLO,3 ;get position of starting bit
IDIVI XHI,3 ;and finishing bit
CAML XHI,PCLN(PIC)
JRST @RETAD
SUB XHI,XLO ;calculate number of pic bytes-1
JUMPG XHI,GT2 ;and if exactly one byte,
SUB XHR,XLR ;calculate how many bits in it-1
GT2: ASH XLR,1 ;calculate jump offset for main loop
SUBI XHR,2 ;and for trailing last byte
MOVN XHR,XHR
ASH XHR,1
MOVEI TT,LINTAB(PIC) ;set up skeleton byte pointer
ADD TT,PCLN(PIC)
SUBI TT,1(XLO) ;for X
MOVE PICPT2,(TT)
PUSH P,12
MOVNI YEX,(YEX) ; loop counter for Y, neg count in left
HRL YLO,YEX ; <TWICE> line number in right
YLOOP2: MOVEI TT,(YLO) ;finish up byte pointer by inserting
ASH TT,-2 ;line address for current Y position
ADD TT,BPTAB(PIC)
MOVE PICPNT,PICPT2
ADD PICPNT,(TT)
LDB TT,PICPNT ;pick up first affected picture byte
JUMPE XHI,RTL2(XHR) ;if only one altogether, skip loop
MOVE NFWD,XHI ;if more than one, do first fractional
JRST STL2(XLR) ;one
FWL2: SUB PICPNT,LNWD(PIC)
LDB TT,PICPNT ;and then do all the others but the last
STL2: ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
CAMLE TT,BMAX(PIC) ;check for byte overflow
MOVE TT,BMAX(PIC)
DPB TT,PICPNT ;return it
SOJG NFWD,FWL2
SUB PICPNT,LNWD(PIC)
LDB TT,PICPNT ;the last affected byte
JRST RTL2(XHR) ;see how much of it to do
RTL2: ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
ILDB T,BITPNT
ADD TT,T
CAMLE TT,BMAX(PIC) ;bounds check
MOVE TT,BMAX(PIC)
DPB TT,PICPNT ;return it
MOVE T,BITPNT ;check if time to skip BP
LSH T,-36 ;in font definition
CAMGE T,RASW ;to next line
AND BITPNT,[7777777777]
AOBJN YLO,YLOOP2 ;check if all lines done
POP P,12
JRST @RETAD
END